unit BLumiaHint;

interface

uses
  Windows, Messages, Classes, Controls, Forms, CommCtrl;

type
  THintWin=class(THintWindow)
  private
    FLastActive: THandle;
  public
    procedure ActivateHint(Rect:TRect;Const AHint:string);override;
  end;

var
  hWndTip: DWORD;

implementation

procedure AddTipTool(hWnd: DWORD; IconType: Integer; Title, Text: PChar);
const
  TTS_BALLOON =$0040;
  TTM_SETTITLE=WM_USER + 32;
var
  ToolInfo: TToolInfo;
begin
  if hWndTip <> 0 then DestroyWindow(hWndTip);//清除重复出现的提示框 ...
  hWndTip:=CreateWindow(TOOLTIPS_CLASS, nil,
          WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
          0, 0, 0, 0, hWnd, 0, HInstance, nil);
  if (hWndTip<>0) then
  begin
    ToolInfo.cbSize:=SizeOf(ToolInfo);
    ToolInfo.uFlags:=TTF_IDISHWND or TTF_SUBCLASS or TTF_TRANSPARENT;
    ToolInfo.uId:=hWnd;
    ToolInfo.lpszText:=Text;
    SendMessage(hWndTip,TTM_ADDTOOL,1,Integer(@ToolInfo));
    SendMessage(hWndTip,TTM_SETTITLE,IconType,Integer(Title));
  end;
  InitCommonControls();
end;

procedure THintWin.ActivateHint(Rect:TRect;const AHint:string);
begin
  try
    caption := AHint;
    AddTipTool(WindowFromPoint(Mouse.CursorPos),1,'GUI Masser', PChar(Caption));
  finally                                  // this ^ can also be [Pchar(Application.Title)]
    FLastActive := GetTickCount;
  end;
end;

initialization
 Application.HintPause:=900;//1000ms = 1s
 Application.ShowHint:=False;
 HintWindowClass:=THintWin; 
 Application.ShowHint:=True;
end. 


